Handling of gpsbabel process and named pipe changed.
authoroliskoli <oliskoli>
Tue, 8 Nov 2005 00:17:22 +0000 (00:17 +0000)
committeroliskoli <oliskoli>
Tue, 8 Nov 2005 00:17:22 +0000 (00:17 +0000)
1  2 
win32/gui-2/utils.pas

index c3f0c9a25fab28db1b5800526531590081640b4a,0000000000000000000000000000000000000000..f9e44cbce7e4ed39d7fc838e5293f81037c8157c
mode 100644,000000..100644
--- /dev/null
@@@ -1,230 -1,0 +1,236 @@@
-     while (WaitforSingleObject (ProcessInfo.hProcess, 0)) <> WAIT_OBJECT_0 do sleep(100);\r
-     if not GetExitCodeProcess(ProcessInfo.hProcess, Error) then Error := 0;\r
\r
-     if (Error <> 0) and (Error <> 1) then\r
-       raise eGPSBabelError.CreateFmt(_('"gpsbabel.exe" returned error 0x%x (%d)'), [Error, Error]);\r
 +unit utils;\r
 +\r
 +{\r
 +    Copyright (C) 2005 Olaf Klein, o.k.klein@t-online.de\r
 +\r
 +    This program is free software; you can redistribute it and/or modify\r
 +    it under the terms of the GNU General Public License as published by\r
 +    the Free Software Foundation; either version 2 of the License, or\r
 +    (at your option) any later version.\r
 +\r
 +    This program is distributed in the hope that it will be useful,\r
 +    but WITHOUT ANY WARRANTY; without even the implied warranty of\r
 +    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
 +    GNU General Public License for more details.\r
 +\r
 +    You should have received a copy of the GNU General Public License\r
 +    along with this program; if not, write to the Free Software\r
 +    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111 USA\r
 +}\r
 +\r
 +{\r
 +    function gpsbabel created from old gui GPSBabelGUIDialogU.pas\r
 +}\r
 +\r
 +interface\r
 +\r
 +uses\r
 +  gnugettextD4,\r
 +  Windows, SysUtils, Classes, Registry;\r
 +\r
 +type\r
 +  PBoolean = ^Boolean;\r
 +\r
 +function gpsbabel(const CommandLine: string; Output: TStrings;\r
 +  Fatal: PBoolean = nil): Boolean;\r
 +\r
 +function GetShortName(const PathName: string): string;\r
 +procedure StoreProfile(const Tag: Integer; const Value: string);\r
 +function ReadProfile(const Tag: Integer): string;\r
 +\r
 +function BackupProperties(Instance: TObject; Properties: TStrings; Backup: TStringList): Boolean;\r
 +procedure RestoreProperties(Instance: TObject; Backup: TStringList);\r
 +\r
 +procedure FixStaticText(AComponent: TComponent);\r
 +\r
 +implementation\r
 +\r
 +uses\r
++  Forms,\r
 +  StdCtrls,\r
 +  common;\r
 +\r
 +function GetShortName(const PathName: string): string;\r
 +var\r
 +  buffer: array[0..4095] of Char;\r
 +  len: DWORD;\r
 +begin\r
 +  len := Windows.GetShortPathName(PChar(PathName), @buffer, sizeof(buffer));\r
 +  SetString(Result, buffer, len);\r
 +end;\r
 +\r
 +function gpsbabel(const CommandLine: string; Output: TStrings;\r
 +  Fatal: PBoolean = nil): Boolean;\r
 +var\r
 +  hRead, hWrite: THandle;\r
 +  ProcessInfo: TProcessInformation;\r
 +  SecurityAttr: TSecurityAttributes;\r
 +  StartupInfo: TStartupInfo;\r
 +  sCmd: string;\r
 +\r
 +  BytesRead, BytesDone: DWORD;\r
 +  buffer: packed array[0..512] of Char;\r
 +  Error: DWORD;\r
++  Wait_Result: DWORD;\r
 +  s: string;\r
 +\r
 +begin\r
 +  Result := False;\r
 +  if (Fatal <> nil) then Fatal^ := False;\r
 +\r
 +  sCmd := SysUtils.Format('%s %s ', [gpsbabel_exe, CommandLine]);\r
 +\r
 +  SecurityAttr.nLength := sizeof (TSECURITYATTRIBUTES);\r
 +  SecurityAttr.bInheritHandle := true;\r
 +  SecurityAttr.lpSecurityDescriptor := nil;\r
 +\r
 +  if not CreatePipe(hRead, hWrite, @SecurityAttr, 0) then\r
 +    raise eGPSBabelError.Create(_('Error WINAPI: Could not create "NamedPipe"!'));\r
 +\r
 +  try\r
 +\r
 +    if not FileExists(gpsbabel_exe) then\r
 +      raise eGPSBabelError.Create(_('"gpsbabel.exe" not found!!!'));\r
 +\r
 +    FillChar (StartupInfo, Sizeof (StartupInfo), #0);\r
 +\r
 +    StartupInfo.cb := Sizeof (StartupInfo);\r
 +    StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;\r
 +    StartupInfo.wShowWindow := SW_HIDE and SW_SHOWMINNOACTIVE;\r
 +    StartupInfo.hStdInput := GetStdHandle (STD_INPUT_HANDLE);\r
 +    StartupInfo.hStdOutput:= hWrite;\r
 +    StartupInfo.hStdError := hWrite;\r
 +\r
 +    FillChar(ProcessInfo, SizeOf(ProcessInfo), #0);\r
 +\r
 +    if not CreateProcess(nil,\r
 +      pchar(sCmd), nil, nil, true, CREATE_NEW_CONSOLE, // dwCreationFlags,     // creation flags\r
 +      nil, nil, StartupInfo, ProcessInfo) then\r
 +    begin\r
 +      Error := GetLastError;\r
 +      raise eGPSBabelError.CreateFmt(\r
 +        _('Could not run "gpsbabel.exe" (Error %d)!'), [Error]);\r
 +    end;\r
-     PeekNamedPipe(hRead, nil, 0, nil, @BytesRead, nil);\r
 +\r
 +    s := '';\r
 +\r
-     while (BytesRead > 0) do\r
-     begin\r
-       ReadFile(hRead, Buffer, SizeOf(buffer)-1, BytesDone, nil);\r
-       buffer[BytesDone] := #0;\r
-       s := s + string(buffer);\r
++    repeat\r
++      Wait_Result := WaitforSingleObject(ProcessInfo.hProcess, 50);\r
++      if PeekNamedPipe(hRead, nil, 0, nil, @BytesRead, nil) then\r
++      begin\r
++        Application.ProcessMessages;\r
++        while (BytesRead > 0) do\r
++        begin\r
++          ReadFile(hRead, Buffer, SizeOf(buffer)-1, BytesDone, nil);\r
++          buffer[BytesDone] := #0;\r
++          s := s + string(buffer);\r
++          Dec(BytesRead, BytesDone);\r
++        end;\r
++      end;\r
++    until (Wait_Result = WAIT_OBJECT_0);\r
 +\r
-       Dec(BytesRead, BytesDone);\r
-     end;\r
++    if not GetExitCodeProcess(ProcessInfo.hProcess, Error) then Error := 0;\r
 +\r
++    if (Error <> 0) and (Error <> 1) then\r
++      raise eGPSBabelError.CreateFmt(_('"gpsbabel.exe" returned error 0x%x (%d)'), [Error, Error]);\r
 +\r
 +    Output.Clear;\r
 +    Output.SetText(PChar(s));\r
 +\r
 +    Result := True;\r
 +    if (Fatal <> nil) then\r
 +      Fatal^ := (Error = 1);\r
 +\r
 +  finally\r
 +    CloseHandle (hRead);\r
 +    CloseHandle (hWrite);\r
 +  end;\r
 +end;\r
 +\r
 +procedure StoreProfile(const Tag: Integer; const Value: string);\r
 +var\r
 +  reg: TRegistry;\r
 +  str: string;\r
 +begin\r
 +  if (Tag <= 0) or (Tag > High(Profile)) then Exit;\r
 +\r
 +  str := Profile[Tag];\r
 +  reg := TRegistry.Create;\r
 +  try\r
 +    reg.RootKey := HKEY_CURRENT_USER;\r
 +    if reg.OpenKey('\SOFTWARE\GPSBabel', True) then\r
 +    begin\r
 +      reg.WriteString(str, Value);\r
 +    end;\r
 +  finally\r
 +    reg.Free;\r
 +  end;\r
 +end;\r
 +\r
 +function ReadProfile(const Tag: Integer): string;\r
 +var\r
 +  reg: TRegistry;\r
 +  str: string;\r
 +begin\r
 +  if (Tag <= 0) or (Tag > High(Profile)) then Exit;\r
 +\r
 +  str := Profile[Tag];\r
 +\r
 +  reg := TRegistry.Create;\r
 +  try\r
 +    reg.RootKey := HKEY_CURRENT_USER;\r
 +    if reg.OpenKey('\SOFTWARE\GPSBabel', True) then\r
 +    begin\r
 +      try\r
 +        Result := reg.ReadString(str);\r
 +      except\r
 +        Result := '';\r
 +      end;\r
 +    end;\r
 +  finally\r
 +    reg.Free;\r
 +  end;\r
 +end;\r
 +\r
 +\r
 +function BackupProperties(Instance: TObject; Properties: TStrings; Backup: TStringList): Boolean;\r
 +var\r
 +  List: TStringList;\r
 +begin\r
 +  List := TStringList.Create;\r
 +  try\r
 +    Backup.Assign(List);\r
 +  finally\r
 +    List.Free;\r
 +  end;\r
 +end;\r
 +\r
 +procedure RestoreProperties(Instance: TObject; Backup: TStringList);\r
 +begin\r
 +end;\r
 +\r
 +procedure FixStaticText(AComponent: TComponent);\r
 +var\r
 +  i, j: Integer;\r
 +  c: TComponent;\r
 +  s: TStaticText;\r
 +begin\r
 +  j := AComponent.ComponentCount;\r
 +  for i := 0 to j - 1 do\r
 +  begin\r
 +    c := AComponent.Components[i];\r
 +    if (c.ComponentCount > 0) then FixStaticText(c);\r
 +\r
 +    if not c.InheritsFrom(TStaticText) then Continue;\r
 +\r
 +    s := c as TStaticText;\r
 +    if (s.BorderStyle = sbsNone) then Continue;\r
 +\r
 +    if (s.Alignment = taLeftJustify) then\r
 +      s.Caption := '   ' + s.Caption\r
 +    else if (s.Alignment = taRightJustify) then\r
 +      s.Caption := s.Caption + '  ';\r
 +  end;\r
 +end;\r
 +\r
 +end.\r